perm filename BDISP.F4[1,MUS]1 blob
sn#084712 filedate 1974-01-30 generic text, type C, neo UTF8
COMMENT ā VALID 00006 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 SUBROUTINE DISP(ZCAR,ZMOD,ZZI1,ZZI2)
C00004 00003 IY=AMP(1)*100.+300.
C00006 00004 CALL ALINE(-400,0,100,0)
C00008 00005 GO TO 60
C00010 00006 102 NC=NC+1
C00011 ENDMK
Cā;
SUBROUTINE DISP(ZCAR,ZMOD,ZZI1,ZZI2)
DIMENSION XFREQ(2)
COMMON FREQ(3,0/50,100),FUNC(100),AMP(100),II(1),IJJ(4000)
CALL DPYTYP(-400,6,1)
302 TYPE 303
303 FORMAT(' CR OR 1 TO CHANGE AMP FUNC'/)
ACCEPT 304,IFUN
304 FORMAT(I)
GO TO (305,306),IFUN+1
306 TYPE 310
310 FORMAT(' NOW AMPLITUDE FUNCTION'/)
CALL GEN(AMP)
305 MIBASE=99999
TYPE 4077
4077 FORMAT(' TYPE SCALE FACT FOR AMP OR CR FOR NO CHANGE'/)
ACCEPT 702,XSKALE
IF(XSKALE.EQ.0.0)GO TO 4078
SKALE=XSKALE
4078 MIFREQ=-400
309 NND=ZZND
TYPE 4001,NND
4001 FORMAT('+NO OF LINES/100 (TIME SLICES) MINUS BOUNDS=',I7/)
TYPE 103
103 FORMAT('+TYPE CR OR -1 FOR NONE OR NEW NUMBER OF LINES/100='/)
ACCEPT 702,XXND
IF(XXND.NE.0.0)ZZND=XXND
IF(XXND.LT.0.0)ND=0
IF(XXND.GT.0.0)ND=100./(XXND+1.)
TYPE 4003,SCALE
4003 FORMAT('+SCALE NOW =',F7.1/)
TYPE 700
700 FORMAT('+TYPE CR OR DISPLAY SCALE='/)
ACCEPT 702,SCAL
IF(SCAL.NE.0.0)SCALE=SCAL
702 FORMAT(F)
104 FORMAT (I)
CALL DPYSET(1,IJJ,4000)
CALL CLRPOG(1)
CALL DPYBIG(5)
CALL DPYTXT(-300,450,'DYNAMIC FM SPECTRUM',4)
CALL ALINE(-400,300,-200,300)
CALL ALINE(-400,400,-400,300)
CALL DPYBIG(1)
CALL DPYTXT(-380,280,'AMP FUNCTION',3)
CALL DPYTXT(-440,400,'1.0',1)
IY=AMP(1)*100.+300.
IX=-400
CALL AIVECT(IX,IY)
DO 401 I=2,100
IX=IX+2
IY=AMP(I)*100.+300.
401 CALL AVECT(IX,IY)
CALL ALINE(100,300,300,300)
CALL ALINE(100,400,100,300)
CALL DPYTXT(120,280,'INDEX FUNCTION',3)
CALL DPYTXT(30,400,'IDX2=',1)
CALL DPYTXT(30,300,'IDX1=',1)
IY=AMP(1)*100.+300.
IX=100
CALL AIVECT(IX,IY)
DO 402 I=2,100
IY=FUNC(I)*100.+300.
IX=IX+2
402 CALL AVECT(IX,IY)
CALL DPYBIG(3)
71 FORMAT(A5)
CALL DPYTXT(-400,-300,'CAR=',1)
XCAR=ZCAR
ENCODE(5,72,XXCAR)XCAR
72 FORMAT(F5.1)
CALL DPYTXT(-360,-300,XXCAR,1)
CALL DPYTXT(-400,-320,'MOD=',1)
XCAR=ZMOD
ENCODE(5,72,XXCAR)XCAR
CALL DPYTXT(-360,-320,XXCAR,1)
CALL DPYTXT(-400,-340,'IDX1=',1)
XI1T=ZZI1
ENCODE(5,72,XXI1T)XI1T
CALL DPYTXT(-360,-340,XXI1T,1)
CALL DPYTXT(-400,-360,'IDX2=',1)
XI2T=ZZI2
ENCODE(5,72,XXI2T)XI2T
CALL DPYTXT(-360,-360,XXI2T,1)
CALL DPYBIG(1)
CALL DPYTXT(60,300,XXI1T,1)
CALL DPYTXT(60,400,XXI2T,1)
CALL DPYBIG(3)
CALL ALINE(-400,0,100,0)
CALL ALINE(100,0,90,5)
CALL ALINE(100,0,90,-5)
CALL ALINE(-400,250,-400,0)
CALL ALINE(-400,250,-395,240)
CALL ALINE(-400,250,-405,240)
CALL DPYTXT(-480,250,'Amp',1)
CALL DPYBIG(1)
CALL DPYTXT(-480,0,'0 Hz',1)
CALL DPYBIG(3)
CALL DPYTXT(115,0,'Time',1)
IX=-400
IY=-90
M=10
CALL DPYTXT(IX,IY,'F',1)
IX=IX+M
IY=IY-M
CALL DPYTXT(IX,IY,'r',1)
IX=IX+M
IY=IY-M
CALL DPYTXT(IX,IY,'e',1)
IX=IX+M
IY=IY-M
CALL DPYTXT(IX,IY,'q',1)
MAX=FREQ(1,50,1)
DO 200 J=0,MAX
KL=1
50 IF(FREQ(1,J,KL).EQ.99999.)GO TO 100
C IF((FREQ(1,J,KL).EQ.0.0).AND.(FREQ(3,J,KL).EQ.0.0))GO TO 100
IX=ABS(FREQ(1,J,KL))*SCALE-400.
ZZ=IX
IY=(ZZ+400.)*(-1.)+250.*FREQ(2,J,KL)*AMP(1)*SKALE
BASE=(ZZ+400.)*(-1.)
IBASE=BASE
IF(MIBASE.GT.IBASE)MIBASE=IBASE
CALL DPYBIG(1)
IF(FREQ(3,J,KL).NE.0.0)GO TO 51
CALL DPYTXT(IX-40,IBASE,'car',1)
GO TO 60
51 ZFREQ=FREQ(1,J,KL)
ENCODE(7,52,XFREQ)ZFREQ
52 FORMAT(F7.2)
CALL DPYTXT(IX-60,IBASE,XFREQ,2)
GO TO 60
100 KL=KL+1
IF(KL.GE.100)GO TO 200
GO TO 50
60 CALL AIVECT(IX,IBASE)
IFREQ=IX
IF(MIFREQ.LT.IFREQ)MIFREQ=IFREQ
DO 61 NO=1,25
CALL SVECT(5,0)
61 CALL SIVECT(15,0)
IF(KL.NE.1)IX=IX+(KL-1)*5
CALL AIVECT(IX,IBASE)
IF(IY.LE.IBASE)IY=(IABS(IY)-IABS(IBASE))+IBASE
IF(FREQ(2,J,KL).NE.0.0)CALL AVECT(IX,IY)
30 CONTINUE
IF(ND.EQ.0)GO TO 36
NC=KL
IF(NC.LE.ND)GO TO 36
31 NC=NC-ND
IF(NC.GT.ND)GO TO 31
36 IFLIP=1
DO 199 KZ=KL+1,100
IF(KL.GT.100)GO TO 199
IF(FREQ(1,J,KZ).EQ.99999.)GO TO 199
IX=IX+5
IY=FREQ(2,J,KZ)*250.*AMP(KZ)*SKALE+BASE
IF(IY.LE.IBASE)IY=(IABS(IY)-IABS(IBASE))+IBASE
IF(FREQ(1,J,KZ).EQ.0.0)IFLIP=-IFLIP
IF(IFLIP.GT.0)GO TO 2001
CALL AIVECT(IX,IY)
GO TO 2002
2001 CALL AVECT(IX,IY)
2002 IF(ND.EQ.0)GO TO 199
IF(FREQ(1,J,KZ).EQ.0.0)GO TO 199
IF(NC.LT.ND)GO TO 102
CALL AVECT(IX,IBASE)
CALL AIVECT(IX,IY)
102 NC=NC+1
IF(NC.GT.ND)NC=1
199 CONTINUE
200 CONTINUE
MIFREQ=MIFREQ+10
MIBASE=MIBASE-10
CALL ALINE(-400,0,MIFREQ,MIBASE)
CALL ALINE(MIFREQ,MIBASE,MIFREQ-2,MIBASE+10)
CALL ALINE(MIFREQ,MIBASE,MIFREQ-10,MIBASE+4)
CALL DPYOUT(1)
TYPE 603
603 FORMAT(' TYPE CR TO FIN'/' 1 TO CHNG AMPF'/)
TYPE 604
604 FORMAT('+ 2 FOR VERT LINES AND SC DISP'/)
ACCEPT 666,N
666 FORMAT(I)
GO TO (302,305),N
CALL HYDPOG(1)
II(1)=IJJ(2)+2
CALL SAVB(II)
RETURN
END